home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 44 / Amiga Format CD44 (1999-08-26)(Future Publishing)(GB)(Track 1 of 3)[!][issue 1999-10].iso / -in_the_mag- / basics / amos / maxsamosdoors.lha / multimax21.amos / multimax21.amosSourceCode
AMOS Source Code  |  1999-01-01  |  7KB  |  288 lines
  1. F= Extension_16_0006(Val(Command Line$))
  2.  
  3. Set Input 10,-1
  4.  
  5. ' set up some variables
  6. Dim N$(20,7)
  7. Global N$()
  8. Global A
  9. Global ST$
  10. Global ESC$
  11. Global CLR$
  12. ESC$=Chr$(27)+"["
  13. CLR$=Chr$(27)+"[2J"+Chr$(27)+"[0;0H"
  14.  
  15. ST$=ESC$+"2J"
  16. PRNT[ST$]
  17.  
  18. Open In 1,"doors:Max-Poll/Max-Poll.data"
  19.  
  20. P=0
  21.  
  22. 10 P=P+1
  23.       If Not Eof(1) Then Line Input #1,N$(P,1)
  24.       If Not Eof(1) Then Line Input #1,N$(P,2)
  25.       If Not Eof(1) Then Line Input #1,N$(P,3)
  26.       If Not Eof(1) Then Line Input #1,N$(P,4)
  27.       If Not Eof(1) Then Line Input #1,N$(P,5)
  28.       If Not Eof(1) Then Line Input #1,N$(P,6)
  29.       If Not Eof(1) Then Line Input #1,N$(P,7)
  30. 20 If Not Eof(1) Then Goto 10
  31.  
  32. Close 1
  33.  
  34. If N$(P,1)="" Then P=P-1
  35.  
  36. 30 Rem               *** main menu
  37. If N$(P,1)="" Then P=P-1
  38. ST$="      Max-Poll by C.C.Wilson, Sysop of Amiga Phoenix BBS 0151 283 6406"
  39. ST$=ESC$+"2J"+ESC$+"5;0H"+ESC$+"37m"+ST$
  40. PRNT[ST$]
  41.  
  42. ST$=ESC$+"9;31H"+ESC$+"31m<"+ESC$+"37mS"+ESC$+"31m>"+ESC$+"33m Show results"
  43. PRNT[ST$]
  44. ST$=ESC$+"11;31H"+ESC$+"31m<"+ESC$+"37mA"+ESC$+"31m>"+ESC$+"33m Answer questions"
  45. PRNT[ST$]
  46. ST$=ESC$+"13;31H"+ESC$+"31m<"+ESC$+"37mL"+ESC$+"31m>"+ESC$+"33m Leave a question"
  47. PRNT[ST$]
  48. ST$=ESC$+"16;31H"+ESC$+"36m<"+ESC$+"37mQ"+ESC$+"36m>"+ESC$+"33m Quit"
  49. PRNT[ST$]
  50. REASON$=Space$(1)
  51. Z= Extension_16_0082(Chr$(27)+"[20;33H"+ESC$+"37mOption: ",REASON$)
  52. If Z<>6 Then Rem BYE
  53. REASON=Instr(REASON$,Chr$(0))
  54. If REASON=0 Then REASON=2
  55. If REASON>1 Then REASON=2
  56. REASON$=Left$(REASON$,REASON-1)
  57. REASON$=Upper$(REASON$)
  58.  
  59. If REASON$="S" Then Goto 2000
  60. If REASON$="A" Then Goto 1000
  61. If REASON$="L" Then Goto 3000
  62. If REASON$="Q" Then BYE
  63.  
  64. Goto 30
  65.  
  66.  
  67. 1000 Rem              *** ask questions 
  68. 1010 Q=1
  69. 1020 Rem              *** main input loop 
  70.  
  71. A1=Val(Left$(N$(Q,7),10))
  72. A2=Val(Mid$(N$(Q,7),10,10))
  73. A3=Val(Mid$(N$(Q,7),20,10))
  74. A4=Val(Mid$(N$(Q,7),30,10))
  75.  
  76. Rem Repeat 
  77.       ST$=ESC$+"2J"+ESC$+"0;0H"+ESC$+"37m"
  78.       PRNT[ST$]
  79.       ST$=ESC$+"3;34HQUESTION "+Str$(Q)
  80.       PRNT[ST$]
  81.       ST$=ESC$+"32m"+ESC$+"6;1H"+Space$((38-Len(N$(Q,1))/2))+N$(Q,1)
  82.       PRNT[ST$]
  83.       ST$=ESC$+"37m"+ESC$+"10;20HA"+ESC$+"35m> "+ESC$+"37m"+N$(Q,2)
  84.       PRNT[ST$]
  85.       ST$=ESC$+"11;20HB"+ESC$+"35m> "+ESC$+"37m"+N$(Q,3)
  86.       PRNT[ST$]
  87.       ST$=ESC$+"12;20HC"+ESC$+"35m> "+ESC$+"37m"+N$(Q,4)
  88.       PRNT[ST$]
  89.       ST$=ESC$+"13;20HD"+ESC$+"35m> "+ESC$+"37m"+N$(Q,5)
  90.       PRNT[ST$]
  91.       ST$=ESC$+"31m"+ESC$+"16;30H<"+ESC$+"37mQ"+ESC$+"31m>"+ESC$+"33m   Quit"
  92.       PRNT[ST$]
  93.       ST$=ESC$+"18;28H"+ESC$+"31m<"+ESC$+"37mEnter"+ESC$+"31m>"+ESC$+"33m Skip question"
  94.       Rem ST$=ST$+ESC$+"20;39H>" 
  95.       PRNT[ST$]
  96.       REASON$=Space$(1)
  97.       Z= Extension_16_0082(Chr$(27)+"[20;35H"+ESC$+"36mAnswer ? ",REASON$)
  98.       If Z<>6 Then Rem BYE
  99.       REASON=Instr(REASON$,Chr$(0))
  100.       If REASON=0 Then REASON=2
  101.       If REASON>1 Then REASON=2
  102.       REASON$=Left$(REASON$,REASON-1)
  103.       REASON$=Upper$(REASON$)
  104. Rem Until REASON$<>""
  105.  
  106. If REASON$="A" Then A1=A1+1
  107. If REASON$="B" Then A2=A2+1
  108. If REASON$="C" Then A3=A3+1
  109. If REASON$="D" Then A4=A4+1
  110. If REASON$="Q" Then Goto DATOUT
  111. If REASON$="" Then Q=Q+1 : Goto 1099
  112. If REASON$<>"A" and REASON$<>"B" and REASON$<>"C" and REASON$<>"D" Then Goto 1099
  113.  
  114. U=Val(N$(Q,6))
  115. N$(Q,6)=Str$(U+1)
  116. N$(Q,7)=Str$(A1)+"        "+Str$(A2)+"        "+Str$(A3)+"        "+Str$(A4)
  117.  
  118. Q=Q+1
  119.  
  120. 1099 If Q>P Then Goto DATOUT
  121.  
  122. 1100 Goto 1020
  123.  
  124.  
  125. 2000 Rem             *** graphical output 
  126. G$=""
  127. For A=1 To 51 : G$=G$+"|" : Next A
  128.  
  129. For Q=1 To P
  130. A1=Val(Left$(N$(Q,7),10))
  131. A2=Val(Mid$(N$(Q,7),10,10))
  132. A3=Val(Mid$(N$(Q,7),20,10))
  133. A4=Val(Mid$(N$(Q,7),30,10))
  134. ST$=CLR$
  135. PRNT[ST$]
  136.  
  137. ST$=ESC$+"3;1H"+ESC$+"37m"+Space$((38-Len(N$(Q,1))/2))+N$(Q,1)
  138. PRNT[ST$]
  139. U=Val(N$(Q,6))
  140.  
  141. ST$=ESC$+"32m"+ESC$+"5;19H("+Str$(U)+" people have answered this question )"
  142. PRNT[ST$]
  143.  
  144. If U=0 Then U=1
  145.  
  146. ST$=ESC$+"37m"+ESC$+"8;10HA> "+N$(Q,2)
  147. PRNT[ST$]
  148. ST$=ESC$+"9;13H"+ESC$+"31m"
  149. P1=((A1*100)/U)
  150. ST$=ST$+Left$(G$,(P1/2))+ESC$+"33m"+Str$(P1)+"%   "+Str$(A1)+" votes"
  151. PRNT[ST$]
  152.  
  153. ST$=ESC$+"37m"+ESC$+"11;10HB> "+N$(Q,3)
  154. PRNT[ST$]
  155. ST$=ESC$+"12;13H"+ESC$+"31m"
  156. P1=((A2*100)/U)
  157. ST$=ST$+Left$(G$,(P1/2))+ESC$+"33m"+Str$(P1)+"%   "+Str$(A2)+" votes"
  158. PRNT[ST$]
  159.  
  160.  
  161. ST$=ESC$+"37m"+ESC$+"14;10HC> "+N$(Q,4)
  162. PRNT[ST$]
  163. ST$=ESC$+"15;13H"+ESC$+"31m"
  164. P1=((A3*100)/U)
  165. ST$=ST$+Left$(G$,(P1/2))+ESC$+"33m"+Str$(P1)+"%   "+Str$(A3)+" votes"
  166. PRNT[ST$]
  167.  
  168.  
  169. ST$=ESC$+"37m"+ESC$+"17;10HD> "+N$(Q,5)
  170. PRNT[ST$]
  171. ST$=ESC$+"18;13H"+ESC$+"31m"
  172. P1=((A4*100)/U)
  173. ST$=ST$+Left$(G$,(P1/2))+ESC$+"33m"+Str$(P1)+"%   "+Str$(A4)+" votes"+ESC$+"37m"
  174. PRNT[ST$]
  175.  
  176. REASON$=Space$(1)
  177. Z= Extension_16_0082(Chr$(27)+"[22;24HEnter to continue / Q to quit ",REASON$)
  178. If Z<>6 Then Rem BYE
  179. Rem REASON=Instr(REASON$,Chr$(0))
  180. Rem If REASON=0 Then REASON=2
  181. Rem If REASON>1 Then REASON=2
  182. Rem REASON$=Left$(REASON$,REASON-1)
  183. REASON$=Upper$(REASON$)
  184. If REASON$="Q" Then Goto 30
  185.  
  186. Next Q
  187.  
  188. Goto 30
  189.  
  190. 3000 Rem             *** user question routine
  191.  
  192. P=P+1
  193. ST$=ESC$+"2J"+ESC$+"37m"
  194. If P=21 Then ST$=ST$+ESC$+"8;8HThere are already the maximum number of questions in the kitty"
  195. If P=21 Then PRNT[ST$] : P=P-1 : Wait 100 : Goto 30
  196. ST$=ST$+ESC$+"8;7HType a question or ENTER to quit. Blank options will be accepted."
  197. PRNT[ST$]
  198. Rem input the data :)
  199.  
  200. REASON$=Space$(70)
  201. Z= Extension_16_0082(Chr$(27)+"[10;0HEnter a question : ",REASON$)
  202. If Z<>6 Then Rem BYE
  203. REASON=Instr(REASON$,Chr$(0))
  204. If REASON=0 Then REASON=61
  205. If REASON>60 Then REASON=60
  206. REASON$=Left$(REASON$,REASON-1)
  207. 'REASON$=Upper$(REASON$) 
  208. If REASON$="" Then Goto 30
  209. N$(P,1)=REASON$
  210.  
  211. REASON$=Space$(35)
  212. Z= Extension_16_0082(Chr$(27)+"[12;18HOption 1 : ",REASON$)
  213. If Z<>6 Then Rem BYE
  214. REASON=Instr(REASON$,Chr$(0))
  215. If REASON=0 Then REASON=31
  216. If REASON>30 Then REASON=31
  217. REASON$=Left$(REASON$,REASON-1)
  218. 'REASON$=Upper$(REASON$) 
  219. N$(P,2)=REASON$
  220.  
  221. REASON$=Space$(35)
  222. Z= Extension_16_0082(Chr$(27)+"[13;18HOption 2 : ",REASON$)
  223. If Z<>6 Then Rem BYE
  224. REASON=Instr(REASON$,Chr$(0))
  225. If REASON=0 Then REASON=31
  226. If REASON>30 Then REASON=31
  227. REASON$=Left$(REASON$,REASON-1)
  228. 'REASON$=Upper$(REASON$) 
  229. N$(P,3)=REASON$
  230.  
  231. REASON$=Space$(35)
  232. Z= Extension_16_0082(Chr$(27)+"[14;18HOption 3 : ",REASON$)
  233. If Z<>6 Then Rem BYE
  234. REASON=Instr(REASON$,Chr$(0))
  235. If REASON=0 Then REASON=31
  236. If REASON>30 Then REASON=31
  237. REASON$=Left$(REASON$,REASON-1)
  238. 'REASON$=Upper$(REASON$) 
  239. N$(P,4)=REASON$
  240.  
  241. REASON$=Space$(35)
  242. Z= Extension_16_0082(Chr$(27)+"[15;18HOption 4 : ",REASON$)
  243. If Z<>6 Then Rem BYE
  244. REASON=Instr(REASON$,Chr$(0))
  245. If REASON=0 Then REASON=31
  246. If REASON>30 Then REASON=31
  247. REASON$=Left$(REASON$,REASON-1)
  248. 'REASON$=Upper$(REASON$) 
  249. N$(P,5)=REASON$
  250. N$(P,6)=" 0"
  251. N$(P,7)=" 0         0         0         0"
  252.  
  253.  
  254. DATOUT:
  255.  
  256. Kill "doors:Max-Poll/Max-Poll.data"
  257.  
  258. Open Out 1,"doors:Max-Poll/Max-Poll.data"
  259.  
  260. For A=1 To P
  261. Print #1,N$(A,1);Chr$(10);
  262. Print #1,N$(A,2);Chr$(10);
  263. Print #1,N$(A,3);Chr$(10);
  264. Print #1,N$(A,4);Chr$(10);
  265. Print #1,N$(A,5);Chr$(10);
  266. Print #1,N$(A,6);Chr$(10);
  267. Print #1,N$(A,7);Chr$(10);
  268. Next A
  269.  
  270. Close 1
  271. Goto 30
  272.  
  273. Procedure PRNT[S$]
  274.    If Len(S$)>70
  275.       A$=Left$(S$,70)
  276.       B$=Right$(S$,Len(S$)-70)
  277.       Z= Extension_16_002A(A$)
  278.       Z= Extension_16_002A(B$+Chr$(13))
  279.    Else 
  280.       Z= Extension_16_002A(S$+Chr$(13))
  281.    End If 
  282.    If Z=20 Then BYE
  283. End Proc
  284.  
  285. Procedure BYE
  286.  Extension_16_0018 
  287. End 
  288. End Proc